Cream of the Crop 25

home *** CD-ROM | disk | FTP | other *** search

/ Cream of the Crop 25 / Cream of the Crop 25.iso / editor / wink10.zip / WINK10.SCR < prev

Wrap

Text File | 1997-04-24 | 65KB | 1 lines

( Wink v1.0, 970424 + ) 2001 LOAD EXIT Copyright (c) 1994-7 Leo Wong. All rights reserved. hello@albany.net http://www.albany.net/~hello/ ( stand alone + ) ( headless requires changes to PYGMY scr # 83) ( $C000 SET-EDGE) ( { 112 132 THRU } ( assembler) ( HEADERS OFF) CREATE TASK 2002 LOAD EXIT ' WINK-BOOT IS BOOT ' WINK-ABORT IS ABORT HEADERS ON PRUNE SAVE WINK10.COM ( pygmy extensions + ) 143 144 THRU ( l words) " DIRECT.SCR" 4 OPEN 4002 4005 THRU 4 ?CLOSE 152 LOAD ( LCMOVE) 153 LOAD ( PEMIT--but not >SCR) 164 LOAD ( SCROLL-UP, SCROLL-DOWN) 169 LOAD ( command line) 171 173 THRU ( shell) 2003 2062 THRU EXIT : .ATTR ( n) CUR@ ROT SPACES AT ; ( code words + ) CODE TUCK AX POP, BX PUSH, AX PUSH, NXT, END-CODE CODE -ROT AX POP, DX POP, BX PUSH, DX PUSH, AX BX MOV, NXT, END-CODE CODE 2SWAP AX POP, CX POP, DX POP, AX PUSH, BX PUSH, DX PUSH, CX BX MOV, NXT, END-CODE CODE 2PUSH AX POP, SWITCH, BX PUSH, AX PUSH, SWITCH, BX POP, NXT, END-CODE CODE 2POP BX PUSH, SWITCH, AX POP, BX POP, SWITCH, AX PUSH, NXT, END-CODE CODE 2+ BX INC, BX INC, NXT, END-CODE CODE <! ( a n) BX AX MOV, BX POP, AX 0 [BX] MOV, BX POP, NXT, END-CODE CODE SWAP- ( n1 n2 - n2-n1) AX POP, AX BX SUB, NXT, END-CODE ( LC@+ from Pygtools + ) CODE LC@+ ( seg offset -- seg offset+1 c) ( offset already in BX) ES POP, ( seg) ES PUSH, ES: 0 [BX] AL MOV, ( retrieve c) BX INC, BX PUSH, AL BL MOV, BH BH SUB, NXT, END-CODE ( 'BL and 'CR + ) 13 CONSTANT 'CR 32 CONSTANT 'BL CODE CR= ( c - f) 13 #, BX SUB, 1 #, BX SUB, BX BX SBB, NXT, END-CODE CODE BL= ( c - f) 32 #, BX SUB, 1 #, BX SUB, BX BX SBB, NXT, END-CODE CODE BL=< ( c - f) 33 #, BX SUB, BX BX SBB, NXT, END-CODE ( tools 1 + ) CODE INCR ( a) 0 [BX] W-PTR INC, BX POP, NXT, END-CODE CODE INCR@ ( a - n) 0 [BX] W-PTR INC, 0 [BX] BX MOV, NXT, END-CODE CODE DECR ( a) 0 [BX] W-PTR DEC, BX POP, NXT, END-CODE CODE DECR@ ( a - n) 0 [BX] W-PTR DEC, 0 [BX] BX MOV, NXT, END-CODE CODE +1-1 ( n m - n+1 m-1) BX DEC, AX POP, AX INC, AX PUSH, NXT, END-CODE : 3DROP 2DROP DROP ; : UMAX 2DUP U< IF NIP ELSE DROP THEN ; : UMIN 2DUP U< IF DROP ELSE NIP THEN ; : CLAMP ( n lo hi - n') ROT MIN MAX ; : ACCEPT ( a u - u') EXPECT SPAN @ ; ( tools 2 + ) : CRs ( n) FOR CR NEXT ; : BEEP 7 EMIT ; : DEEP ( n) DROP BEEP ; : WAIT ." Press a key to continue..." KEY DROP ; CREATE table 128 ALLOT : TABLE 0 table 128 FOR 2DUP C! 1+ 1 +UNDER NEXT 2DROP ; : >table table 'A + 26 FOR DUP C@ $20 OR OVER C! 1+ NEXT DROP ; : TAble TABLE >table ; CODE lcase ( a u>0) BX CX MOV, table #, BX MOV, DI POP, BEGIN, 0 [DI] AL MOV, XLAT, AL 0 [DI] MOV, DI INC, LOOP, BX POP, NXT, END-CODE ( tools 3 + ) EXIT : C>c ( C - c) DUP 'A 'Z BETWEEN 'BL AND XOR ; : lcase ( a u) FOR C@+ C>c OVER 1- C! NEXT DROP ; CODE C>c ( C - c) BL AL MOV, table #, BX MOV, XLAT, AL BX MOV, BH BH SUB, NXT, END-CODE CODE CC>cc ( CC - cc) BX CX MOV, table #, BX MOV, CL AL MOV, XLAT, AL CL MOV, CH AL LMOV, XLAT, AL CH MOV, CX BX MOV, NXT, END-CODE ( vectored execution + ) VARIABLE mode CODE CALL ( a n) 1 #, BX SHL, AX POP, AX BX ADD, 0 [BX] AX MOV, BX POP, AX JMP, NXT, END-CODE : MODE ( n) CREATE FOR ' , NEXT DOES> mode @ CALL ; : Special ( c key# a) -ROT - CALL ; EXIT : CALL ( a n) 2* + @ EXECUTE ; : DIAL: : DOES> ( n) SWAP CALL ; ( strings + ) : TRAILING<> ( a u c - a1 u1) OVER PUSH -TRAILING<> DUP +UNDER POP SWAP- ; : -PATH ( a u - a' u') '\ TRAILING<> ': TRAILING<> ; : -LEADING ( a u - a' u') 'BL -LEADING= ; : PEEL ( a u - a' u') -LEADING -TRAILING ; : C+! ( n a) DUP C@ +UNDER C! ; : S+! ( a u s) 2DUP 2PUSH COUNT + SWAP CMOVE 2POP C+! ; : SMOVE ( s1 s2) OVER C@ 1+ CMOVE ; EXIT CODE -TRAILING<> ( a # c - a #') STD, 1 #, AL OR, DS AX MOV, AX ES MOV, BX AX MOV, CX POP, DI POP, DI PUSH, CX DI ADD, DI DEC, REPNZ, AL SCAS, 0=, IF, CX INC, THEN, CX BX MOV, CLD, NXT, END-CODE ( cursor words from Pygtools + ) CODE VBIOS ( DX CX BX AX -- DX' CX' BX' AX' ) ( general call to the video bios ) BX AX MOV, BX POP, CX POP, DX POP, SI PUSH, BP PUSH, $10 INT, BP POP, SI POP, DX PUSH, CX PUSH, BX PUSH, AX BX MOV, NXT, END-CODE : VCMD ( DX CX BX AX -) VBIOS 2DROP 2DROP ; : >CURSOR ( n-) 0 TUCK $100 VCMD ; ( Set Cursor Size ) : -CURSOR ( -- ) 0 $2007 0 $100 VCMD ; ( Turn cursor off ) ( $007 =Big Block Cursor) : SMALL $607 >CURSOR ; ( $607 =Normal cursor) : BIGGER $407 >CURSOR ; ( $407 =Box Cursor) 3 MODE +CURSOR SMALL BIGGER SMALL ( cursor positioning + ) : ROW ( - u) CUR@ DROP ; : COL ( - u) CUR@ NIP ; : CAT ( u) ROW SWAP AT ; EXIT : RAT ( u) COL AT ; ( screen/page + ) 24 CONSTANT STATUS 2 CONSTANT TOP 5 CONSTANT LEFT 5 CONSTANT TABWIDTH STATUS TOP - CONSTANT LMAX/SCREEN 50 CONSTANT LINES/PAGE 60 CONSTANT PICA 11 CONSTANT PMARGIN 70 CONSTANT ELITE 14 CONSTANT EMARGIN DEFER LINEWIDTH ' PICA IS LINEWIDTH DEFER MARGIN ' PMARGIN IS MARGIN TOP LMAX/SCREEN + 1- CONSTANT BOTTOM : RIGHT LEFT LINEWIDTH + 1+ ; ( text/block + ) ( -1 CONSTANT TMAX) VARIABLE tsize VARIABLE cnow VARIABLE cold VARIABLE topline VARIABLE oldtop VARIABLE lnow VARIABLE lold VARIABLE lend : -TEND ( - f) cnow @ tsize @ SWAP- ; : ROOM? ( u - f) tsize @ OVER + 1+ U< ; ( lines 1 + ) 512 CONSTANT GULP ( used in sweep and read) 5000 CONSTANT LMAX : LINES ( - a) PAD GULP + ; : LINE ( # - a) 2* LINES + ; : LINESPEC ( l# - a u) LINE 2@ TUCK - ; : LINELENGTH ( l# - u) LINESPEC NIP ; : 0LINES ( l#1 l#2) OVER LINE -ROT SWAP- 1+ 0 MAX 2* 0 FILL ; : 0>LMAX 0 LMAX 1- 0LINES ; ( lines 2 + ) : LINES+! ( n) lnow @ 1+ DUP LINE SWAP lend @ SWAP- 1+ 0 MAX FOR 2DUP +! 2+ NEXT 2DROP ; : LINES> ( l#) DUP LINE DUP 2+ ROT lend INCR@ SWAP- 2* 0 MAX CMOVE> ; : <LINES ( l#) 1+ DUP LINE DUP 2+ SWAP ROT lend @ SWAP- 2* 0 MAX CMOVE lend DECR ; ( char#>line#>row# + ) : C>L ( c# l# - l#') OVER tsize @ U< NOT IF 2DROP lend @ ELSE OVER IF 1- LINE BEGIN 2+ 2DUP @ U< UNTIL NIP LINES - 2/ 1- ELSE DROP THEN THEN ; : >ROW ( l# - u) topline @ - TOP + ; : BOTTOMLINE ( - u) topline @ LMAX/SCREEN + 1- ; : AIM ( cnow n ) SWAP 0 C>L lnow N! DUP topline @ BOTTOMLINE BETWEEN IF 2DROP ELSE SWAP- 0 MAX topline N! lnow ! THEN ; ( virgin mother + ) : MOTHER 0>LMAX 0 cnow N! lnow N! lend N! topline ! ; : VIRGIN MOTHER tsize OFF ; ( segments + ) VARIABLE tseg VARIABLE bseg : SEGS CS@ $1000 + tseg N! $1000 + bseg ! ; : TSEG ( - seg) tseg @ ; : BSEG ( - seg) bseg @ ; : SPOT ( - tseg a) TSEG cnow @ ; : SPOT@ ( - c) SPOT LC@ ; : T>PAD ( seg a u - pad u) PUSH CS@ PAD R@ LCMOVE PAD POP ; ( screen display 1 +) $74 CONSTANT RED-ON-GRAY $71 CONSTANT BLUE-ON-GRAY $17 CONSTANT GRAY-ON-BLUE $07 CONSTANT GRAY-ON-BLACK $70 CONSTANT BLACK-ON-GRAY CREATE text GRAY-ON-BLUE , BLACK-ON-GRAY , VARIABLE frame RED-ON-GRAY frame ! : COLOR ( a) @ ATTR ! ; : DOS-COLOR GRAY-ON-BLACK ATTR ! ; : MONO? VSEG @ $B000 = ; : ?MONO MONO? IF BLACK-ON-GRAY GRAY-ON-BLACK text 2! BLACK-ON-GRAY frame ! THEN ; : BOW SMALL DOS-COLOR CLS ; ( screen display 2 +) : RUB ( r) 0 2DUP AT CR AT ; : .RULER text COLOR TOP 1- DUP RUB ." Line |" LINEWIDTH TABWIDTH / FOR ." ----+" NEXT COL 1- AT ." |Page" ; : .FKEYS frame COLOR 0 RUB ." F1 Find 2 Next 3 Put 4 Also 5 Mark " ." 6 Cut 7 Copy 8 Paste 9 Print 10 Bye " ; : .SCREEN text COLOR CLS frame COLOR 0 RUB STATUS RUB text COLOR BOTTOM RUB .FKEYS .RULER TOP LEFT AT ; : WARNING ( s) BEEP 0 RUB TYPE$ SPACE WAIT ; ( text display 1 + ) DEFER "cr" ' 'BL IS "cr" DEFER "bl" ' 'BL IS "bl" 250 CONSTANT .BL 20 CONSTANT .CR : ~DISPLAY "cr" 'BL XOR IF ['] 'BL DUP IS "bl" IS "cr" ELSE ['] .BL IS "bl" ['] .CR IS "cr" THEN oldtop ON ; : ?DISPLAY ( c - 'c) DUP BL=< IF 'BL XOR IF "cr" ELSE "bl" THEN THEN ; DEFER ?MARK ' NOP IS ?MARK ( text display 2 + ) VARIABLE .start VARIABLE .end VARIABLE wipe : EraseEOL CUR@ CR AT ; : EraseEOS ROW BOTTOM SWAP- 1+ CRs ; : TTYPE ( seg a u) FOR LC@+ ?DISPLAY ?MARK EMIT NEXT 2DROP text COLOR EraseEOL ; : .LINE# ( l#) 1+ 4 U.R ; : PAGE ( l# - p# n) LINES/PAGE U/MOD 1+ SWAP ; : .PAGE ( l#) PAGE IF DROP ELSE LEFT LINEWIDTH + 2+ CAT 2 U.R THEN ; ( text display 3 + ) : .TLINE ( l# seg l# - l#) DUP .LINE# SPACE LINESPEC TTYPE DUP .PAGE CR ; : .TLINES text COLOR TSEG .start @ topline @ MAX DUP >ROW 0 AT DUP .end @ BOTTOMLINE MIN SWAP- 1+ FOR 2DUP .TLINE 1+ NEXT 2DROP lend @ BOTTOMLINE U< IF topline @ lend @ SWAP- 1+ TOP + 0 AT CR wipe @ IF EraseEOS THEN THEN ; ( status display 1 + ) VARIABLE col# : .FILENAME frame COLOR STATUS 0 AT ARG$ COUNT -PATH TUCK TYPE 14 SWAP- SPACES ; : .OF ( u s) TYPE$ 2+ DUP SPACES " of" TYPE$ 1+ SPACES ; : .STATUSLINE .FILENAME 5 " Char" .OF " Col" TYPE$ 5 SPACES 4 " Line" .OF 2 " Page" .OF ; : .INSERT ." Ins" ; : .OVERWRITE ." Ovr" ; : .MARK ." Mrk" ; 3 MODE .MODE .INSERT .OVERWRITE .MARK ( status display 2 + ) : U.L ( u #) SWAP <# #S OVER PUSH #> POP - SPACES ; : .STATUS frame COLOR STATUS PUSH R@ 19 AT cnow @ 1+ 5 U.L R@ 28 AT tsize @ 5 U.L R@ 39 AT col# @ 1+ 2 U.L lend @ lnow @ 2DUP R@ 48 AT 1+ 4 U.L R@ 56 AT 1+ 4 U.L R@ 67 AT PAGE DROP 3 U.L R@ 73 AT PAGE DROP 3 U.L POP 76 AT .MODE ; ( right, left, up, down + ) : Right -TEND IF cnow INCR ELSE BEEP THEN ; : Left cnow @ IF cnow DECR ELSE BEEP THEN ; : CPLACE ( - #) lnow @ LINE @ cnow @ SWAP- ; : >CNOW ( cplace l#) LINESPEC ROT 2DUP U< IF DROP 1- 0 MAX ELSE NIP THEN + cnow ! ; : Up lnow @ IF CPLACE lnow DECR@ >CNOW ELSE BEEP THEN ; : Down lnow @ lend @ U< IF CPLACE lnow INCR@ >CNOW ELSE BEEP THEN ; ( tdown and tup + ) : PANE ( u) TOP MAX LEFT BOTTOM RIGHT 1 text @ ; : TDOWN ( u) PANE SCROLL-DOWN BOTTOMLINE lend @ U< NOT IF lend @ DUP >ROW 0 AT text COLOR DUP .LINE# .PAGE THEN ; : TUP ( u) 1+ PANE SCROLL-UP lend @ BOTTOMLINE < NOT IF tsize @ lend @ 1+ LINE ! BOTTOM 0 AT BOTTOMLINE TSEG OVER text COLOR .TLINE DROP THEN ; ( format 1 + ) VARIABLE same VARIABLE line# : ?SAME ( a 'line) @ = IF line# @ lnow @ OVER U< OVER LINELENGTH LINEWIDTH U< AND AND ?DUP IF .end ! same ON THEN THEN ; : LINE! ( a) line# INCR@ LINE 2DUP ?SAME ! ; : CReturn ( a) line# @ DUP PUSH 1+ LINE @ 2DUP U< IF 2DROP R@ DUP LINES> BOTTOMLINE U< IF R@ >ROW TDOWN THEN ELSE SWAP U< IF R@ DUP <LINES BOTTOMLINE U< IF R@ >ROW TUP THEN THEN THEN POP DROP ; ( format 2 + ) : WRAP ( a pad u - a') 2DUP 'CR -LEADING<> IF NIP SWAP- 1+ + DUP CReturn DUP LINE! ELSE DROP DUP LINEWIDTH 2+ = IF 1- 'BL -TRAILING<> ?DUP IF DUP LINEWIDTH > IF 2DUP + C@ BL= NEGATE + THEN NIP ELSE DROP LINEWIDTH THEN + DUP LINE! ELSE NIP + THEN THEN ; : DEJA? same @ IF lend DUP @ line# @ 1- MAX <! tsize @ lend @ 1+ LINE ! ELSE lend @ 1+ line# @ lend N! .end N! 1+ tsize @ OVER LINE ! 1+ SWAP 0LINES THEN ; ( format 3 + ) : FORMAT same OFF TSEG lnow @ 1- 0 MAX .start N! .end N! line# N! LINE @ BEGIN 2DUP DUP DUP LINEWIDTH 2+ + tsize @ UMIN SWAP- T>PAD WRAP DUP tsize @ = same @ OR UNTIL 2DROP DEJA? ; ( text pushes and pulls + ) : #>END ( a - u) tsize @ SWAP- ; : JOIN ( u) PUSH SPOT 2DUP POP + DUP #>END PUSH 2SWAP POP LCMOVE ; : <#SLIDE ( u) tsize @ IF DUP JOIN NEGATE tsize +! ELSE DEEP THEN ; : <SLIDE 1 <#SLIDE -1 LINES+! ; : SPLIT ( u) PUSH SPOT 2DUP POP OVER #>END PUSH + POP LCMOVE> ; : #SLIDE> ( u) DUP ROOM? IF DUP SPLIT tsize +! ELSE DEEP THEN ; : SLIDE> 1 #SLIDE> 1 LINES+! ; ( text input + ) : OVERWRITE ( c) SPOT LC! tsize DUP @ cnow INCR@ UMAX <! FORMAT ; : INSERT ( c) -TEND IF SLIDE> THEN OVERWRITE ; ( delete and backspace + ) : ?PARA SPOT@ CR= lnow @ BOTTOMLINE U< AND IF lnow @ <LINES ROW TUP THEN ; : DELETE -TEND IF ?PARA <SLIDE FORMAT ELSE BEEP THEN ; : <DELETE cnow @ IF Left DELETE ELSE BEEP THEN ; ( Enter + ) : PARAGRAPH lnow @ DUP LINES> BOTTOMLINE U< IF ROW 1+ TDOWN THEN 'CR INSERT ; : RETURN -TEND IF lnow @ LINE @ cnow ! Down ELSE mode @ 2 XOR IF PARAGRAPH ELSE BEEP THEN THEN ; 3 MODE Enter PARAGRAPH RETURN RETURN ( Tab + ) CREATE TAB$ HERE TABWIDTH DUP ALLOT 'BL FILL : TAB ( u) DUP ROOM? IF DUP PUSH #SLIDE> CS@ TAB$ SPOT R@ LCMOVE POP DUP LINES+! cnow +! FORMAT ELSE DEEP THEN ; : tab ( u) -TEND IF cnow TUCK @ + lnow @ 1+ LINE @ 1- MIN <! ELSE mode @ 2 XOR IF TAB ELSE DEEP THEN THEN ; 3 MODE <tab> TAB tab tab : Tab TABWIDTH CPLACE OVER UMOD - <tab> ; ( prev word + ) ( bl includes ascii 32 and ascii 13 i.e. ascii 32 and lower) : -BL ( - f) 'BL SPOT@ U< ; : BL< ( u1 - u2) 1- BEGIN DUP Left -BL AND WHILE 1- REPEAT ; : -BL< ( u1 - u2) 1- BEGIN DUP Left -BL NOT AND WHILE 1- REPEAT ; : PrevWord cnow @ ?DUP IF BL< DUP IF -BL< THEN DUP IF BL< THEN DROP -BL NOT IF Right THEN cnow @ 21 AIM ELSE BEEP THEN ; ( next word + ) ( bl includes ascii 32 and ascii 13 i.e. ascii 32 and lower) : >BL ( u1 - u2) 1- BEGIN DUP Right -BL AND WHILE 1- REPEAT ; : >-BL ( u1 - u2) 1- BEGIN DUP Right -BL NOT AND WHILE 1- REPEAT ; : NextWord -TEND ?DUP IF >BL DUP IF >-BL THEN DROP cnow @ 0 AIM wipe ON ELSE BEEP THEN ; ( jumps 1 + ) : CONFINE ( #1 - #2) 0 lend @ CLAMP ; : JUMP ( n) DUP topline @ + CONFINE topline ! CPLACE SWAP lnow @ + CONFINE lnow N! >CNOW ; : +JUMP ( u) lnow @ lend @ = IF DEEP ELSE JUMP THEN ; : -JUMP ( u) lnow @ 0= IF DEEP ELSE NEGATE JUMP THEN ; : Home lnow @ LINE @ cnow ! ; : End lnow @ 1+ LINE @ 1- tsize @ UMIN cnow ! ; : PgUp LMAX/SCREEN -JUMP ; : PgDn LMAX/SCREEN +JUMP wipe ON ; ( jumps 2 + ) : Ctrl-Home 0 cnow N! lnow N! topline ! ; : Ctrl-End tsize @ cnow ! lend @ lnow N! .end N! DUP topline @ LMAX/SCREEN + 1- > IF 1- .start N! topline ! wipe ON ELSE DROP THEN ; : Ctrl-PgUp topline @ lnow @ U< IF CPLACE topline @ lnow N! >CNOW ELSE BEEP THEN ; : Ctrl-PgDn lnow @ DUP lend @ U< SWAP BOTTOMLINE U< AND IF CPLACE lend @ BOTTOMLINE MIN lnow N! >CNOW ELSE BEEP THEN ; ( cursor keys, ~insert + ) CREATE CURKEYS ] Home Up PgUp NOP Left NOP Right NOP End Down PgDn [ : CURKEY ( c) 71 CURKEYS Special ; CREATE CTRL-CURKEYS ] PrevWord NextWord Ctrl-End Ctrl-PgDn Ctrl-Home [ : CTRL-CUR ( c) 115 CTRL-CURKEYS Special ; : ~INSERT mode DUP @ 1 XOR <! ; 3 MODE Insert ~INSERT ~INSERT BEEP ( find/replace 1 + ) 64 CONSTANT S/R-MAX CREATE S$ S/R-MAX ALLOT S$ 1+ CONSTANT S$+ VARIABLE slen VARIABLE slen< CREATE lastchar 1 ALLOT VARIABLE found VARIABLE pad> VARIABLE rlen CREATE R$ S/R-MAX ALLOT ( find/replace 2 + ) : UC? ( a u - f) FOR C@+ 'A 'Z BETWEEN IF POP 2DROP -1 EXIT THEN NEXT DROP 0 ; : lc? ( a u - f) FOR C@+ 'a 'z BETWEEN IF POP 2DROP -1 EXIT THEN NEXT DROP 0 ; : MIXED? ( a u - f) 2DUP UC? PUSH lc? POP AND ; DEFER ?lcase : ?MIXED ( a u) 2DUP MIXED? IF ['] 2DROP ELSE ['] lcase THEN IS ?lcase ?lcase ; ( find/replace 3 + ) : -FOUND ( a u - a+1 u-1|0) +1-1 OVER S$+ slen< @ COMP 0= IF OVER PAD - 1- pad> ! DROP 0 found ON THEN ; : LOOKING ( a u) S$ C@ PUSH 2DUP ?lcase R@ -LEADING<> DUP IF lastchar C@ -TRAILING<> DUP IF BEGIN -FOUND R@ -LEADING<> DUP 0= UNTIL THEN THEN POP 3DROP ; ( find/replace 4 + ) VARIABLE back VARIABLE snow VARIABLE gulp< : SWEEP back ON GULP slen< @ - gulp< ! tsize @ PUSH TSEG cnow @ 1+ DUP R@ 1+ slen @ - U< AND BEGIN snow N! 2DUP DUP DUP GULP + R@ UMIN DUP PUSH SWAP- T>PAD LOOKING POP R@ = back @ AND IF DROP 0 back OFF ELSE gulp< @ + THEN DUP cnow @ U< back @ OR NOT found @ OR UNTIL POP 3DROP ; ( find/replace 5 + ) : ?FOUND found @ IF snow @ pad> @ + cnow N! cold N! 6 AIM wipe ON ELSE BEEP THEN ; : SEEK -CURSOR found OFF slen @ ?DUP IF tsize @ 1+ U< IF S$ slen @ 2DUP ?MIXED 1- slen< N! + C@ lastchar C! SWEEP THEN THEN ?FOUND +CURSOR ; : SEEK? 0 RUB ." Search for:" S$ S/R-MAX ACCEPT ?DUP IF slen ! SEEK THEN .FKEYS ; ( find/replace 6 + ) : POINT? ( - f) found @ cold @ cnow @ = AND ; : SLIDE ( n) DUP 0< IF NEGATE <#SLIDE ELSE #SLIDE> THEN ; : PUT POINT? rlen @ DUP PUSH AND R@ slen @ - TUCK 0 MAX ROOM? AND IF ?DUP IF DUP SLIDE LINES+! THEN CS@ R$ SPOT R@ LCMOVE FORMAT ELSE DEEP THEN POP DROP found OFF ; : PUT? POINT? IF 0 RUB ." Substitute:" R$ S/R-MAX ACCEPT rlen ! PUT .FKEYS ELSE BEEP found OFF THEN ; ( find/replace 7 + ) 3 MODE Find SEEK? SEEK? BEEP 3 MODE Next SEEK SEEK BEEP 3 MODE Swap PUT? PUT? BEEP 3 MODE Also PUT PUT BEEP ( block 1 + ) VARIABLE bstart VARIABLE .bstart VARIABLE .bend : BIN ( a - u) DUP @ tsize @ 1- UMIN SWAP N! ; DEFER ?BLOCK ' NOP IS ?BLOCK : <BLOCK> cnow BIN bstart @ 2DUP UMIN .bstart ! UMAX .bend ! lold @ lnow @ 2DUP MIN .start ! MAX .end ! ; : <LL> ( - l1 l2) .bstart @ 0 C>L .bend @ OVER C>L ; : MARK ( a c - a c) OVER 1- .bstart @ .bend @ BETWEEN 2 AND text + COLOR ; ( block 2 + ) VARIABLE was VARIABLE btop VARIABLE blength : +MARK mode DUP @ was ! 2 <! ['] MARK IS ?MARK ['] <BLOCK> IS ?BLOCK cnow BIN bstart ! topline @ btop ! oldtop ON ; : -MARK <LL> .end ! .start ! was @ mode ! ['] NOP DUP IS ?MARK IS ?BLOCK ; ( cut, copy, paste + ) : APE .bend @ .bstart @ TUCK - 1+ blength ! TSEG SWAP BSEG 0 blength @ LCMOVE -MARK ; : CUT APE .bend @ .bstart @ DUP 0 C>L .start N! lnow ! cnow N! - 1+ DUP <#SLIDE NEGATE LINES+! FORMAT btop @ topline @ U< IF btop @ topline ! THEN wipe ON lend @ .end ! ; : PASTE blength @ DUP ROOM? IF DUP PUSH #SLIDE> BSEG 0 SPOT R@ LCMOVE POP LINES+! FORMAT ELSE DEEP THEN ; ( some modes + ) 3 MODE CHARACTER INSERT OVERWRITE DEEP 3 MODE Backspace <DELETE <DELETE BEEP 3 MODE Delete DELETE DELETE CUT 3 MODE ~Mark +MARK +MARK -MARK 3 MODE Cut BEEP BEEP CUT 3 MODE Copy BEEP BEEP APE 3 MODE Paste PASTE PASTE BEEP ( print 1 + ) ( printer words from Pygtools + ) CODE PBIOS ( port svc - stat) BX AX MOV, DX POP, $17 INT, BH BH SUB, AH BL MOV, NXT, END-CODE : PRN-STAT ( port - stat) $200 PBIOS ; ( LPT1=port 0) : PRN-OK ( - f) 0 PRN-STAT 144 = ; VARIABLE spacing VARIABLE pline : SPACED ( u) spacing ! ; : FF 12 EMIT ; : .PAGE# ( n) MARGIN LINEWIDTH + SPACES 1+ . ; ( print 2 + ) : NEWPAGE ( n) FF 3 CRs .PAGE# 3 CRs ; : ?NEWPAGE pline @ ?DUP IF LINES/PAGE spacing @ / U/MOD SWAP 0= IF NEWPAGE ELSE DROP THEN ELSE 6 CRs THEN ; : TPRINT ( seg a u) FOR LC@+ DUP 'CR > AND EMIT NEXT 2DROP ; : <print> ( start end) PRN-OK IF -CURSOR >PRN pline OFF TSEG -ROT OVER - 1+ FOR ?NEWPAGE MARGIN SPACES 2DUP LINESPEC TPRINT spacing @ CRs pline INCR 1+ NEXT 2DROP FF >DIRECT ELSE 2DROP " Printer not ready." WARNING .FKEYS THEN ; ( print 3 + ) : print ( n) 0 lend @ <print> ; : bprint ( n) <LL> <print> ; : PRINT 1 SPACED print ; : BPRINT 1 SPACED bprint ; : 2PRINT 2 SPACED print ; : 2BPRINT 2 SPACED bprint ; 3 MODE Print PRINT PRINT BPRINT 3 MODE 2Print 2PRINT 2PRINT 2BPRINT ( file words 1 + ) VARIABLE fhandle : >DOT ( s - n) COUNT '. -TRAILING<> NIP ; : +0 ( s) COUNT + 0 SWAP C! ; : ?+WNK ( s) DUP PUSH >DOT NOT IF " .wnk" COUNT R@ S+! THEN POP +0 ; : FILENAME ( $ - u) 0 RUB TYPE$ PAD 1+ 78 ACCEPT DUP PAD C! ; : PAD$>ARG$ PAD ARG$ SMOVE ; : ?FILE GETARG$ COUNT PEEL ?DUP IF 0 ARG$ C! ARG$ S+! ELSE DROP frame COLOR +CURSOR " Filename:" FILENAME IF PAD$>ARG$ ELSE BOW BYE THEN THEN ARG$ ?+WNK ; : BADNAME " Couldn't make or save the file." WARNING ; ( file words 2 + ) : LINE>FILE ( seg l#) LINESPEC T>PAD fhandle @ FILE-WRITE ; : FSAVE ( s) FMAKE IF DROP BADNAME .FKEYS ELSE fhandle ! TSEG 0 lend @ 1+ FOR 2DUP LINE>FILE 1+ NEXT 2DROP fhandle @ FCLOSE THEN ; : FILE-SAVE ARG$ FSAVE ; : ?FSAVE ( c) 196 = IF FILE-SAVE ELSE BEEP 0 RUB ." Leaving Wink: save any changes (y/n)?" KEY 'BL OR 'y = IF FILE-SAVE THEN THEN ; ( file words 3 + ) : READ ( unit# - handle#) HANDLE @ DUP PUSH FILE-SIZE ABORT" FILE TOO BIG" tsize ! R@ >BOF BEGIN PAD GULP R@ FILE-READ #BYTES-READ @ ?DUP WHILE PUSH CS@ PAD SPOT R@ LCMOVE POP cnow +! REPEAT POP cnow OFF ; : NEW ( unit# - handle#) DUP MAKE HANDLE @ ; : ?READ ARG$ 3 TUCK UNIT DUP EXISTS? IF READ ELSE NEW THEN FCLOSE ; : FILE ?FILE ?READ ; : BACKUP PAD 128 0 FILL ARG$ PAD SMOVE PAD >DOT ?DUP IF 1- PAD C! THEN " .bak" COUNT PAD S+! PAD FSAVE ; : ?BACKUP tsize @ IF BACKUP THEN ; ( >dos, ~name + ) ( shell words from L. Greg Lisle's CHANGES.SCR) : Cshell ( tail$) " C:\COMMAND.COM" SWAP shell ; : LSHELL $D00 PAD ! PAD Cshell ; : .DOS> BOW frame COLOR 0 RUB ." Type EXIT and press Enter to return to Wink. " 0 0 (AT ; : >DOS .DOS> LSHELL 0 0 AT oldtop ON .SCREEN .STATUSLINE ; : ~NAME " New filename:" FILENAME IF PAD ?+WNK PAD FMAKE NIP IF BADNAME ELSE PAD$>ARG$ ARG$ +0 .FILENAME FILE-SAVE THEN THEN .FKEYS ; ( ~line, ~colors + ) : ~LINEWIDTH LINEWIDTH ELITE XOR IF ['] ELITE ['] EMARGIN ELSE ['] PICA ['] PMARGIN THEN IS MARGIN IS LINEWIDTH MOTHER wipe ON FORMAT .RULER ; 3 MODE ~LINE ~LINEWIDTH ~LINEWIDTH BEEP : ~COLORS text 2@ SWAP text 2! .RULER oldtop ON wipe ON ; ( fkeys, shift-fkeys + ) CREATE FKEYS ] Find Next Swap Also ~Mark Cut Copy Paste Print [ : FKEY ( c) 59 FKEYS Special ; CREATE SHIFT-FKEYS ] >DOS ~NAME ~LINE ~DISPLAY BEEP BEEP BEEP ~COLORS 2Print FILE-SAVE [ : SHIFT-FKEY ( c) 84 SHIFT-FKEYS Special ; ( .result + ) CREATE CURSOR> 4 ALLOT : WINDOW TOP 0 BOTTOM 79 1 text @ ; : SCRUP WINDOW SCROLL-UP topline INCR BOTTOMLINE DUP 1- .start ! .end ! ; : SCROWN WINDOW SCROLL-DOWN topline DECR@ .start ! ; : SCROLL? ( row - row') DUP BOTTOM > IF SCRUP DROP BOTTOM topline @ oldtop ! ELSE DUP TOP U< IF SCROWN 1+ topline @ oldtop ! THEN THEN ; : CURSOR! cnow @ DUP lnow @ 1- 0 MAX C>L lnow N! DUP >ROW SCROLL? -ROT LINE @ - col# N! LEFT + CURSOR> 2! ; : ?FRAME topline @ oldtop @ XOR IF topline @ .start ! lend @ .end ! THEN ; : .RESULT -CURSOR CURSOR! ?FRAME .TLINES .STATUS CURSOR> 2@ AT +CURSOR ; ( start + ) : (c) CLS 12 11 AT -CURSOR ." Wink v1.0 " ." Copyright 1994-7 Leo Wong. All rights reserved." ; : START VIRGIN SEGS TAble INIT-VIDEO >DIRECT ?MONO text COLOR (c) FILE .SCREEN .STATUSLINE FORMAT .RESULT ?BACKUP ; ( process 1 + ) : PROCESS> 0 wipe ! lnow @ lold N! 1- topline @ oldtop N! lend @ CLAMP .start N! 1- .end ! ; ( process 2 + ) : PROCESS ( c) PROCESS> DUP 'BL 126 BETWEEN IF DUP CHARACTER ELSE DUP CR= IF Enter ELSE DUP 9 = IF Tab ELSE DUP 8 = IF Backspace ELSE $80 XOR DUP 83 = IF Delete ELSE DUP 71 81 BETWEEN IF DUP CURKEY ELSE DUP 82 = IF Insert ELSE DUP 59 68 BETWEEN IF DUP FKEY ELSE DUP 115 119 BETWEEN IF DUP CTRL-CUR ELSE DUP 4 = IF Ctrl-PgUp ELSE DUP 84 93 BETWEEN IF DUP SHIFT-FKEY ELSE BEEP THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN DROP ; ( wink + ) : WINK START BEGIN KEY DUP 196 = OVER 231 = OR NOT WHILE PROCESS ?BLOCK .RESULT REPEAT ?FSAVE BOW ; : WINK-BOOT WINK BYE ; : WINK-ABORT >SCR +CURSOR BEEP CR POP POP TYPE$ CR BYE ;